⓪ IMPLEMENTATION MODULE ModCtrl;⓪ (*$Y+,P-,V+,C-,R-*)⓪ ⓪ (* V#115⓪"15.01.88 TT GetModName mit Prozedurnamen⓪"01.04.88 TT findName fängt Bus/Addr-Error ab.⓪"02.04.88 TT InstallModule: Bei unterstem Level wird Basepage, Environment⓪0und aller allozierter Speicher (ALLOCATE + SysAlloc) resident⓪0gemacht.⓪"10.06.88 TT GetModName: IF-Abfrage vor Prozedurnamen-Ermitteln korrigiert.⓪"27.08.88 TT GetModName/findName zerstört nicht mehr Addr-Error-Exc-Vektor⓪0und außerdem wird Stack bei Bus/Addr-Error nun auch bei 68020⓪0richtig wiederhergestellt.⓪"30.09.88 TT KeepAll wieder aus InstallModule entfernt;⓪0ModList und eigenes CODE-Segment/Basepage werden bei DeInstall⓪0entfert, wenn Prg resident war.⓪"09.12.88 TT Residentmachen/Freigabe von gelinktem Modul wird über 'linked'-⓪0Flag in 'state' statt über ModLevel erkannt.⓪"10.12.88 TT ReleaseModule holt sich eigene Basepage-Adr via 'GetPDB' statt⓪0aus 'BaseProcess'.⓪"04.07.89 TT Install/ReleaseModule: Residentmachen bei gelinkten Prgs⓪0erfolgt erst bei deren Prozeßende.⓪"14.07.89 TT ReleaseModule: Freigabe der base page/tpa geschieht direkt⓪0über gemdos.mfree, da sonst Probleme bei residenten Prgs⓪0auftritt.⓪"26.07.89 TT CatchProcessTerm wird nicht doppelt installiert, wenn⓪0InstallModule doppelt aufgerufen wird.⓪"09.10.89 TT GetModName bestimmt Proc-Name nun wieder korrekt;⓪0falls sourceName bei GetSourceName nicht paßt, wird Pfad⓪0abgeschnitten⓪"13.06.90 TT EnterSupervisorMode-Aufrufe raus⓪"17.07.90 TT QueryImports neu⓪"26.09.90 TT GetProcAddr meldet nicht schon Erfolg, wenn nur der zu kurz⓪0angegebene Name paßt.⓪"14.02.92 TT GEMDOS.Super-Aufrufe statt Supexec wg. MinT.⓪"23.02.92 TT Anpassung an neues "CreateBasePage".⓪"24.06.94 TT Neben FullStorBaseAccess wird nun auch ExtendedMemoryAccess⓪0beim Residentinstallieren geprüft, damit man dieses Flag auch⓪0noch im Hauptprg. auf FALSE setzen kann. Falls Modul resident⓪0installiert wird, wird PtermRes erst ganz am Ende aller⓪0Termination-Handler aufgerufen (bisher passierte dies eher⓪0gleich am Anfang und so wurden evtl. die restlichen Handler⓪0zu spät aufgerufen). Falls Ptermres() zum Installieren benutzt⓪0werden muß, wird dies nicht mehr hier sondern in MOSCtrl⓪0erledigt.⓪ *)⓪ ⓪ FROM SYSTEM IMPORT ASSEMBLER, ADR, WORD, ADDRESS, DEREF, TSIZE, LONGWORD;⓪ ⓪ FROM ModBase IMPORT FindRef, ModLst, CallEnvelopes, ModRef, ModStates,⓪0MarkState, ModState, PtrModHeader, ModHeader,⓪0CreateBasePage, ExecProcess, ModLoaded, ModStr;⓪ ⓪ FROM StorBase IMPORT Keep, FullStorBaseAccess;⓪ ⓪ FROM MOSCtrl IMPORT BaseResident, CallRemoveProcs, GetPDB, PDB,⓪(TermEntry, ModLevel, PtrPDB;⓪ ⓪ FROM MOSSupport IMPORT ToSuper, ToUser;⓪ ⓪ FROM SysTypes IMPORT PtrBP;⓪ ⓪ FROM MOSGlobals IMPORT IllegalState, MemArea;⓪ ⓪ FROM PrgCtrl IMPORT TermProcess, TermCarrier, CatchProcessTerm;⓪ ⓪ FROM Lists IMPORT ResetList, PrevEntry, RemoveEntry, DeleteList, List,⓪(NextEntry, LDir;⓪ ⓪ FROM FileNames IMPORT PathConc, SplitPath;⓪ ⓪ FROM Strings IMPORT Assign, Length, StrEqual, Upper, Delete, Split, Pos;⓪ ⓪ FROM MOSConfig IMPORT ExtendedMemoryAccess;⓪ ⓪ ⓪ VAR caught,ok,error:BOOLEAN;⓪$wsp: MemArea;⓪$tcarrier: TermCarrier;⓪$MakeResident, madeResident: BOOLEAN;⓪ ⓪ PROCEDURE findNameAddr (modhead,name:ADDRESS): ADDRESS;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(; Format der Namen vor Procs:⓪(; ... code ... RTS⓪(; 0-Byte auf gerade Adr.⓪(; Name mit Null am Ende⓪(; [0-Byte f. SYNC]⓪(; Ptr auf vorige Proc hinter diesen Ptr⓪(;⓪(SUBQ.L #4,A3⓪(SUBQ.L #4,A7⓪(JSR ToSuper⓪(⓪(LEA err2(PC),A0⓪(MOVE.L 8,D0⓪(MOVE.L A0,8 ; Bus error⓪(MOVE.L 12,D1⓪(MOVE.L A0,12 ; Addr error⓪(⓪(MOVE.L (A3),A2 ; rel⓪(MOVE.L -(A3),A0 ; mod⓪(MOVE.L ModHeader.body(A0),D1⓪%l: MOVE.L D1,A1⓪(ADDA.L A0,A1 ; A1 zeigt auf Proc-Beginn (hinter Namen)⓪(⓪(MOVEM.L D1/A1/A2,(A3) ; D1/A1/A2 retten⓪(SUBQ.L #6,A1⓪%m: TST.B -(A1)⓪(BNE m⓪(ADDQ.L #1,A1 ; nun zeigt A1 auf Namen⓪(; vergleichen⓪%n: MOVE.B (A1)+,D1⓪(BEQ found⓪(CMPI.B #'a',D1⓪(BCS o⓪(CMPI.B #'z',D1⓪(BHI o⓪(SUBI.B #32,D1⓪%o: CMP.B (A2)+,D1⓪(BEQ n⓪(MOVEM.L (A3),D1/A1/A2⓪(⓪(MOVE.L -(A1),D1 ; Vorgänger-Proc⓪(BEQ e ; nicht gefunden ('rel' zu klein)⓪(BRA l⓪%err2⓪(SUBA.W #14,A7 ; Bus/Addr-Error, SSP korrigieren⓪(MOVEQ #0,D1⓪(BRA e⓪%found:⓪(TST.B (A2) ; auch Name im Code zuende?⓪(BNE l ; nein: weitersuchen⓪(MOVEM.L (A3),D1/A1/A2⓪%e: MOVE.L D1,(A3)+⓪(⓪(MOVE.L D0,8 ; Bus error⓪(MOVE.L D1,12 ; Addr error⓪(⓪(JSR ToUser⓪(ADDQ.L #4,A7⓪$END⓪"END findNameAddr;⓪"(*$L=*)⓪ ⓪ PROCEDURE GetProcAddr (mname: ARRAY OF CHAR; VAR location: ADDRESS);⓪"VAR dummy, pname: ARRAY [0..39] OF CHAR; withPN, getBody, ok: BOOLEAN;⓪&code: ADDRESS; ref0: ModRef;⓪"BEGIN⓪$Upper (mname);⓪$withPN:= Pos ('.', mname, 0) > 0;⓪$IF withPN THEN⓪&Split (mname, Pos ('.', mname, 0), mname, pname, ok);⓪&Delete (pname, 0, 1, ok);⓪&IF pname[0]=0C THEN⓪(withPN:= FALSE⓪&ELSE⓪(getBody:= StrEqual (pname, mname);⓪&END⓪$END;⓪$location:= NIL;⓪$IF ModLoaded (mname, FALSE, dummy, ref0) THEN⓪&IF withPN THEN⓪(code:= ref0^.header;⓪(IF getBody THEN⓪*location:= code + ref0^.header^.body⓪(ELSIF procSym IN ref0^.state THEN⓪*location:= findNameAddr (code, ADR (pname));⓪*IF location # NIL THEN INC (location, LONGCARD(code)) END;⓪(END⓪&ELSE⓪(location:= ref0^.codeStart⓪&END⓪$END⓪"END GetProcAddr;⓪ ⓪ (*$H+*)⓪ PROCEDURE ProcQuery (REF modName: ARRAY OF CHAR;⓪9call : ProcQueryProc;⓪5VAR ok : BOOLEAN);⓪"VAR dummy: ModStr; ref0: ModRef; p, pa: ADDRESS; pn: LONGCARD;⓪"TYPE PL = POINTER TO LONGCARD;⓪'PC = POINTER TO CHAR;⓪'PS = POINTER TO ARRAY [0..39] OF CHAR;⓪"BEGIN⓪$ok:= FALSE;⓪$IF ModLoaded (modName, FALSE, dummy, ref0) THEN⓪&WITH ref0^ DO⓪(IF (procSym IN state) THEN⓪*(* ... code ... RTS⓪.0-Byte auf gerade Adr.⓪.Name mit Null am Ende⓪.0-Byte f. SYNC]⓪.Ptr auf vorige Proc hinter diesen Ptr *)⓪*pn:= header^.body; (* Beim Body fängt die Kette rückw. an *)⓪*WHILE pn # 0 DO⓪,p:= ADDRESS(header) + pn; (* Proc-Adr. absolut *)⓪,pa:= p; (* Proc-Adr. merken *)⓪,DEC (p, 4); (* zum Ptr vor Name *)⓪,pn:= DEREF (PL(p));⓪,DEC (p, 3); (* zum Ende des Namens *)⓪,WHILE DEREF(PC(p)) # 0C DO DEC (p) END; (* zum Beginn d. Namens *)⓪,call (DEREF (PS(p+1)), pa)⓪*END;⓪*ok:= TRUE⓪(END;⓪&END; (* WITH *)⓪$END⓪"END ProcQuery;⓪ ⓪ PROCEDURE ModQuery ( call: ModQueryProc );⓪"VAR l:List; m: ModRef;⓪"BEGIN⓪$l:=ModLst;⓪$ResetList (l);⓪$LOOP⓪&m:= NextEntry (l);⓪&IF m = NIL THEN EXIT END;⓪&WITH m^ DO⓪(call ( codeName^, codeStart, codeLen, varRef, varLen,⓪/fileName (*PathConc (fileName, filePath)*),⓪/~(program IN state), loaded IN state,⓪/(installed IN state) OR (linked IN state) );⓪&END;⓪$END⓪"END ModQuery;⓪ ⓪ PROCEDURE QueryImports (REF client: ARRAY OF CHAR; call: ModQueryProc);⓪"VAR dummy: ModStr; ref0: ModRef; imp: POINTER TO ModRef;⓪"BEGIN⓪$IF ModLoaded (client, FALSE, dummy, ref0) THEN⓪&imp:= ADDRESS (ref0^.imports);⓪&IF imp # NIL (* existiert Importliste? *) THEN⓪(WHILE imp^ # NIL DO⓪*WITH imp^^ DO⓪,call (codeName^, codeStart, codeLen, varRef, varLen,⓪2fileName (*PathConc (fileName, filePath)*),⓪2~(program IN state), loaded IN state,⓪2(installed IN state) OR (linked IN state))⓪*END;⓪*INC (imp, 4)⓪(END⓪&END⓪$END⓪"END QueryImports;⓪ (*$H-*)⓪ ⓪ ⓪ PROCEDURE findName (modhead:ADDRESS;rel:LONGCARD): ADDRESS;⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(; Format der Namen vor Procs:⓪(; ... code ... RTS⓪(; 0-Byte auf gerade Adr.⓪(; Name mit Null am Ende⓪(; [0-Byte f. SYNC]⓪(; ^ auf vorige Proc hinter diesen ^ (rel. zu header!)⓪(;⓪(SUBQ.L #4,A3⓪(SUBQ.L #4,A7⓪(JSR ToSuper⓪ ⓪(LEA err2(PC),A0⓪(MOVE.L 8,-(A7)⓪(MOVE.L A0,8 ; Bus error⓪(MOVE.L 12,-(A7)⓪(MOVE.L A0,12 ; Addr error⓪(MOVE.L A7,A2⓪ ⓪(MOVE.L (A3),D0 ; rel⓪(MOVE.L -(A3),A0 ; header⓪(ADD.L ModHeader.codeStart(A0),D0⓪(MOVE.L ModHeader.body(A0),D1⓪ ⓪%l: MOVE.L D1,A1 ; rel. Proc-Beginn⓪(ADDA.L A0,A1 ; abs. Proc-Beginn⓪(CMP.L D1,D0⓪(BCC found⓪(MOVE.L -(A1),D1 ; Vorgänger-Proc⓪(BEQ e ; nicht gefunden ('rel' zu klein)⓪(BRA l⓪%err2⓪(MOVE.L A2,A7 ; Bus/Addr-Error, SSP korrigieren⓪(MOVEQ #0,D1⓪(BRA e⓪%found:⓪(SUBQ.L #6,A1⓪%m: TST.B -(A1)⓪(BNE m⓪(ADDQ.L #1,A1⓪(MOVE.L A1,D1⓪%e: MOVE.L D1,(A3)+⓪(⓪(MOVE.L (A7)+,12 ; Addr error⓪(MOVE.L (A7)+,8 ; Bus error⓪$⓪(JSR ToUser⓪(ADDQ.L #4,A7⓪$END⓪"END findName;⓪"(*$L=*)⓪ ⓪ PROCEDURE GetModName ( Ad : Address;⓪7VAR modul : ARRAY OF Char;⓪7VAR relAddr : LONGCARD;⓪7VAR procName: ARRAY OF CHAR );⓪"VAR i: ModRef; n: POINTER TO ARRAY [0..79] OF CHAR;⓪"BEGIN⓪$FindRef (ad,i);⓪$relAddr:= 0L;⓪$procName[0]:= 0C;⓪$IF i=NIL THEN⓪&modul[0]:= 0C;⓪$ELSE⓪&Assign (i^.codename^,modul,ok);⓪&relAddr:= ad - i^.codeStart;⓪&IF procSym IN i^.state THEN⓪(n:= findName (i^.header, relAddr);⓪(IF n # NIL THEN⓪*Assign (n^, procName, ok)⓪(END⓪&END;⓪&IF crunched IN i^.state THEN⓪(relAddr:= 0L (* wurde vorher noch gebraucht ! *)⓪&END⓪$END⓪"END GetModName;⓪ ⓪ ⓪ VAR dummy: ADDRESS;⓪ ⓪ PROCEDURE CatchProcessTermLast (VAR hdl: TermCarrier; call: Proc; wsp: MemArea);⓪"(*⓪#* Proc ganz ans Ende der Term-Liste, damit diese Routine als ALLERLETZTE⓪#* aufgerufen wird.⓪#* Zudem wird die Routine im untersten PDB, also dem des gelinkten Prozesses,⓪#* installiert.⓪#*)⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(CLR.L -(A7)⓪(MOVE.L A7,(A3)+⓪(MOVE.L #dummy,(A3)+⓪(JSR GetPDB⓪(MOVE.L (A7)+,A0⓪(MOVE.L A0,D0⓪(BEQ noMod⓪(; untersten PDB finden⓪&findBottom:⓪(MOVE.L PDB.prev(A0),D0⓪(BEQ foundBottom⓪(MOVE.L D0,A0⓪(BRA findBottom⓪&foundBottom:⓪(; Ende der Term-Liste finden⓪&findEnd:⓪(MOVE.L PDB.TermProcs(A0),D1⓪(BEQ foundEnd⓪(MOVE.L D1,A0⓪(BRA findEnd⓪&foundEnd:⓪(MOVE.L -(A3),D2⓪(MOVE.L -(A3),A2⓪(MOVE.L -(A3),D0⓪(MOVE.L -(A3),A1⓪(MOVE.L A1,PDB.TermProcs(A0) ; pdb.TermProcs:= ADR (hdl)⓪(CLR.L TermEntry.next(A1) ; hdl.next:= NIL (end of list)⓪(MOVE.L D0,TermEntry.call(A1) ; hdl.call:= call⓪(MOVE.L D2,TermEntry.wsp.length(A1)⓪(MOVE.L A2,TermEntry.wsp.bottom(A1)⓪(RTS⓪&noMod:⓪(TRAP #6⓪(DC.W -14 ; Ill. call⓪(SUBA.W #$10,A3⓪$END⓪"END CatchProcessTermLast;⓪"(*$L+*)⓪ ⓪ PROCEDURE termination;⓪"VAR p: PtrPDB; pr: ADDRESS; bp: PtrBP;⓪"BEGIN⓪$IF MakeResident & madeResident THEN⓪&madeResident:= TRUE;⓪&GetPDB (p,pr);⓪&bp:= p^.basePageAddr;⓪&Keep (bp);⓪&Keep (bp^.p_env)⓪$END⓪"END termination;⓪ ⓪ PROCEDURE InstallModule (removalInfo: PROC; wsp: MemArea);⓪"VAR i:ModRef; ad:Address; inst: BOOLEAN;⓪"BEGIN⓪$ASSEMBLER⓪&MOVE.L 4(A5),ad(A6) ; RTS-Adr. v.Stack⓪$END;⓪$FindRef (ad,i);⓪$inst:= FALSE;⓪$IF i=NIL THEN⓪&(* Ist wohl ein gelinktes, optimiertes Modul *)⓪&inst:= TRUE;⓪$ELSIF ~(installed IN i^.state) THEN⓪&Incl (i^.state,installed);⓪&i^.removeInfo:= removalInfo;⓪&i^.removeWsp:= wsp;⓪&IF linked IN i^.state THEN⓪(inst:= TRUE;⓪&END⓪$END;⓪$IF inst THEN⓪&(*⓪'* Das Residentmachen des eigenen Programmbereichs & basepage⓪'* erfolgt erst beim Prozeßende, falls dann MakeResident noch TRUE ist.⓪'*)⓪&IF NOT caught & FullStorBaseAccess () & ExtendedMemoryAccess THEN⓪(CatchProcessTermLast (tcarrier, termination, wsp);⓪(MakeResident:= TRUE;⓪(madeResident:= FALSE;⓪(caught:= TRUE⓪&ELSE⓪((*⓪)* Prg muß mit Ptermres() resident gemacht werden.⓪)* Das wird automatisch in MOSCtrl erledigt.⓪)*)⓪(BaseResident:= TRUE;⓪&END⓪$END⓪"END InstallModule;⓪ ⓪ ⓪ PROCEDURE Mfree (ad: ADDRESS);⓪"(*$L-*)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),-(A7)⓪(MOVE.W #$49,-(A7)⓪(TRAP #1⓪(ADDQ.L #6,A7⓪$END⓪"END Mfree;⓪"(*$L=*)⓪ ⓪ PROCEDURE ReleaseModule;⓪"VAR i:ModRef; ad:Address; p: PtrPDB; pr: ADDRESS; bp: PtrBP; deinst: BOOLEAN;⓪"BEGIN⓪$ASSEMBLER⓪&MOVE.L 4(A5),ad(A6) ; RTS-Adr. v.Stack⓪$END;⓪$FindRef (ad,i);⓪$deinst:= FALSE;⓪$IF i=NIL THEN⓪&(* Ist wohl ein gelinktes, optimiertes Modul *)⓪&deinst:= TRUE⓪$ELSIF installed IN i^.state THEN⓪&EXCL (i^.state,installed);⓪&IF (linked IN i^.state) THEN⓪(deinst:= TRUE;⓪&END⓪$END;⓪$IF deinst & (MakeResident OR BaseResident) THEN⓪&BaseResident:= FALSE;⓪&MakeResident:= FALSE;⓪&IF ModLevel = 0 THEN⓪((*⓪)* Nur eigene Freigabe, wenn DeInstall nicht noch vor Ende des⓪)* eigenen Prozesses, unter dem auch Installed wurde, aufgerufen⓪)* wird.⓪)*)⓪(CallRemoveProcs; (* Hierüber wird auch 'removal' in ModBase aufgerufen *)⓪((*⓪)* Auch der eigene Programmplatz wird freigegeben -> Vorsicht !⓪)*)⓪(IF madeResident THEN⓪*GetPDB (p, pr);⓪*bp:= p^.basePageAddr;⓪*Mfree (bp^.p_env);(* nicht DEALLOCATE verwenden, weil durch *)⓪*Mfree (bp); (* Removal-Aufrufe bereits Storage abgemeldet ist!*)⓪*(*⓪+* Hiernach muß das Programm selbst enden !⓪+*)⓪)END⓪&END;⓪$END⓪"END ReleaseModule;⓪ ⓪ ⓪ PROCEDURE FirstModuleStart ():Boolean;⓪"VAR i:ModRef; ad:Address;⓪"BEGIN⓪$ASSEMBLER⓪&MOVE.L 4(A5),ad(A6) ; RTS-Adr. v.Stack⓪$END;⓪$FindRef (ad,i);⓪$IF i=NIL THEN⓪&(* Ist wohl ein gelinktes, optimiertes Modul *)⓪&RETURN TRUE⓪$ELSE⓪&RETURN (firstCall IN i^.state) OR (linked IN i^.state)⓪$END⓪"END FirstModuleStart;⓪ ⓪ ⓪ PROCEDURE GetOwnName (VAR codeName: ARRAY OF CHAR);⓪"VAR i:ModRef; ad:Address;⓪"BEGIN⓪$ASSEMBLER⓪&MOVE.L 4(A5),ad(A6) ; RTS-Adr. v.Stack⓪$END;⓪$codename[0]:=0C;⓪$FindRef (ad,i);⓪$IF i=NIL THEN⓪&(* Ist wohl ein gelinktes, optimiertes Modul *)⓪&codeName[0]:= 0C⓪$ELSE⓪&Assign (i^.codeName^,codeName,ok)⓪$END⓪"END GetOwnName;⓪ ⓪ ⓪ PROCEDURE GetSourceName ( REF codeName : ARRAY OF CHAR;⓪:VAR sourceName: ARRAY OF CHAR;⓪:VAR opts : LONGWORD );⓪"VAR r:ModRef; mname:ModStr; path: ARRAY [0..127] OF CHAR;⓪&p: POINTER TO ModStr;⓪"BEGIN⓪$IF ModLoaded (codename,FALSE,mname,r) & ~(program IN r^.state) THEN⓪&p:= ADDRESS (r^.header) + r^.header^.sourceName;⓪&Assign (p^, sourceName, ok);⓪&IF ~ ok THEN⓪(SplitPath (p^, path, sourceName)⓪&END;⓪&opts:= r^.header^.options⓪$ELSE⓪&sourceName[0]:=0C;⓪&opts:= LONGWORD (0L)⓪$END⓪"END GetSourceName;⓪ ⓪ ⓪ PROCEDURE CallProcess ( pro : PROC;⓪;workSpace: MemArea;⓪7VAR ok : BOOLEAN;⓪7VAR exitCode : INTEGER );⓪ ⓪"VAR bp: PtrBP; termState: CARDINAL; noStr: CHAR;⓪"⓪"BEGIN (* CallProcess *)⓪$noStr:= 0C;⓪$ok:= CreateBasePage (bp, 0, ADR(noStr), LONGCARD(7));⓪$IF ok THEN⓪&WITH bp^ DO⓪(p_lowtpa:= workSpace.bottom;⓪(p_hitpa:= p_lowtpa + workSpace.length⓪&END;⓪&ExecProcess (bp, pro, ADR(noStr), LONGCARD(7), termState, exitCode);⓪&ok:= termState = 2;⓪&Mfree (bp^.p_env);⓪&Mfree (bp)⓪$END⓪"END CallProcess;⓪ ⓪ END ModCtrl.⓪ ə
